perm filename DFUNC.F4[MUS,LCS] blob
sn#166832 filedate 1975-06-27 generic text, type T, neo UTF8
00100 C ********** DISPLAY OUTPUT **********
00200 SUBROUTINE DPY(F,IY)
00300 DIMENSION F(1)
00400 IF(IY)GO TO 3
00450 C IY IS TO SUPERIMPOSE WAVES FROM 'CRUNCH'
00500 2 CALL DPYX(IY)
00600 CALL DPYBRT(5)
00700 3 J=F(1)*256.0
00750 I=J+128
00800 CALL AIVECT(-256,I)
00900 DO 1017 K=2,512
01000 I=F(K)*256.0
01100 CALL RVECT(1,I-J)
01200 1017 J=I
01300 CALL DPYOUT(1)
01500 END
01600
01700 SUBROUTINE DPYX(IGRID)
01800 C ON DATADISK GRIDS MUST BE RESEST EACH TIME AROUND.
01810 COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
01855 1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
01900 COMMON FUNC(512),F2(512),K,I
02000 COMMON/DY/IDPY(800),NUMS(5)
02200 DATA NUMS/'1','25','50','75','100'/
02300 CALL DDCLR
02400 C75 CALL CLRPOG(1)
02500 IT=-180
02600 IB=-500
02800 CALL TYPLOC(IT,IB)
02900 CALL DPYSET(1,IDPY,800)
03000 CALL DPYBRT(2)
03100 IF(IGRID.NE.1)GO TO 2
03200 CALL ALINE(256,128,-258,128)
03300 CALL ALINE(-256,-128,-256,384)
03325 10 CALL DPYBIG(6)
03350 CALL DPYTXT(-410,240,FNUM1,1)
03400 CALL DPYOUT(1)
03500 RETURN
03600
03700 C DRAWS GRIDWORK
03800 2 DO 501 K=384,-128,-128
03900 501 CALL ALINE(256,K,-258,K)
04000 DO 502 K=-256,260,128
04100 502 CALL ALINE(K,-130,K,384)
04200 N=-268
04300 CALL DPYBIG(3)
04400 CALL DPYTXT(-285,124,'0',1)
04500 DO 503 K=1,5
04600 CALL DPYTXT(N,388,NUMS(K),1)
04700 503 N=N+128
04800 C NUMBERS OVER GRID
04900 GO TO 10
05000 END
05100
05200 SUBROUTINE PLOTIT(FUNC,EY,P)
05210 COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
05230 1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
05300 DIMENSION FUNC(1)
05310 IF(P.EQ.'P')GO TO 1
05315 IF(P.EQ.0)GO TO 4
05317 Y=1
05320 X=2.
05321 IF(P.NE.'X')GO TO 6
05323 X=1.5
05324 Y=.5
05325 6 CALL PLOTS(K)
05327 P=0
05330 GO TO 40
05400 1 TYPE 2
05440 CALL PLOTS(K)
05500 ACCEPT 3,X
05600 IF(X.EQ.0)X=SZX
05700 IF(X.EQ.0)X=1.
05800 SZX=X
05900 40 SZ=X/5.12
05910 S=0
05920 J=1
06010 JK=X*3
06020 CALL SYMBOL(SZ,4.*SZ,JK,0,FLNM,5)
06030 4 CALL SYMBOL(SZ,-3.*SZ,JK,0,B(2,JX),3)
06080 CALL PLOT(5.12*SZ,0.,3)
06090 CALL PLOT(0.,0.,2)
06100 CALL PLOT(0.,-2.*SZ,3)
06200 CALL PLOT(0.,2.*SZ,2)
06500
06600 72 CALL PLOT(.01*SZ,FUNC(1)*2.*SZ,3)
06700 DO 73 K=2,512
06800 R=K/100.0
06900 73 CALL PLOT(R*SZ,FUNC(K)*2.*SZ,2)
06910 T=0
06920 Q=Y+5*SZ
06930 IF(J.NE.5)GO TO 5
06940 Q=-S
06950 T=-7*SZ
07000 5 CALL PLOT(Q,T,-3)
07010 S=S+Q
07020 J=J+1
07200
07300 2 FORMAT(' TYPE SIZE - '$)
07400 3 FORMAT(F)
07500 END